home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
008
/
edgra3.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-02-22
|
22KB
|
586 lines
(*---
FileName : EDGRA3.pas Version : July 24, 1986
made by : JOS
Objective:
This is the EXTENDED graphics editor. version 3
Last Changes
Aug 21, 1986 => expansion of the help feature.
Sep 26, 1986 => Addition of the CircleSegment routine. NOTE Active Color = 'E'
---*)
program GRAPHICS_EDITOR;
{$V-} {V = avoid String Checking in passing parameters}
{$I \JOS\JOS-var.pas}
(* Variables Used for ED-GRA *)
type
STRING10 = STRING[10];
var
POSI, TOPP1, TNUMBP1, ITM,
X, Y, INCX, INCY, I, J,
ACTIVE_COLOR, COLOR : integer;
HIRES_MODE, SAVE_FILE : boolean;
FNAME : STRING8;
RESP, CH_MOVE : char;
{ procedure to re-assign values to the variable NUMB }
procedure ASSIGN_VALUES (SYS_NUM, SHEET_NUM, CODE : integer); begin end;
{$I \jos\graph.p}
{$I \JOS\JOS-UTIL.PAS}
{$I \JOS\JOS-UTI2.pas}
{$I \JOS\JOS-UTI3.pas}
{$I \JOS\JOS-GRA2.PAS}
(*--- NOT VERY EFFICIENT ROUTINE IS NOT USED IN THIS FILE !!!!!!!
Procedure to fill a square (defined by x1,y1,x2,y2) of the screen
with a character number NCHAR.
if MODE = 0 is TextMode and CODE = 0 -> fill character byte.
CODE = 1 -> fill atribute byte.
MODE = 1 is HiRes, coordinates in Hires: 0 <= X <= 639, 0 <= Y <= 199.
MODE = 2 is HiRes, coordinates in TextMode: 0 <= X <= 80, 0 <= Y <= 25.
---*)
procedure CLR_AREA (X1, Y1, X2, Y2, NCHAR, MODE, CODE : INTEGER);
VAR
X, Y : INTEGER;
begin
CASE MODE OF
0 : for Y := Y1 TO Y2 do
for X := X1 TO X2 do
MEM [$B800:$0 + (Y-1)*160 + (X-1)*2 + CODE] := NCHAR;
1 : for Y := Y1 TO Y2 do
if (Y MOD 2) = 0 then
for X := (X1 DIV 8) TO (X2 DIV 8) do
MEM [$B800:$0 + (Y DIV 2)*80 + X] := NCHAR
ELSE
for X := (X1 DIV 8) TO (X2 DIV 8) do
MEM [$BA00:$0 + (Y DIV 2)*80 + X] := NCHAR;
2 : begin
Y1 := (Y1-1)*8; Y2 := (Y2-1)*8 + 7;
for Y := Y1 TO Y2 do
if (Y MOD 2) = 0 then
for X := X1 TO X2 do begin
MEM [$B800:$0 + (Y DIV 2)*80 + X-1] := NCHAR;
MEM [$BA00:$0 + (Y DIV 2)*80 + X-1] := NCHAR;
end;
end;
end;
end;
procedure CODE_WRITE;
begin
rewrite (CODEFILE);
for I := 1 to TOP do
case COMM[I] of
'*', ' ','@','#', 'T' : writeln (CODEFILE, COMM[I], STNG[I]);
'N' : begin
write (CODEFILE, COMM[I]);
for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4);
J := PAR [I,3];
writeln (CODEFILE, FORMAT[J,1]:4, FORMAT[J,2]:4,' ',
NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]);
end;
else begin
write (CODEFILE, COMM[I]);
for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4);
writeln (CODEFILE, ' ', STNG[i]); end;
end; { case }
writeln (CODEFILE, 'Q end of file set by EDGRA3');
writeln (TOP:10, 'Lineas written');
close (CODEFILE);
end;
procedure CODE_LIST;
var CH, CH2 : char; LFR, LTO, LE, i, j : integer;
procedure LIST;
begin
ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas');
gotoxy (10,5); write ('Give starting line :');
gotoxy (10,6); write ('Give ending line :');
LFR := trunc(INPUT_REAL(34,5,LFR, 1, TOP-1, 5,0, CH));
LTO := trunc(INPUT_REAL(34,6,LTO, LFR+1, TOP, 5,0, CH)); gotoxy(1,8);
for I := LFR to LTO do begin
write (i:3, ' => ');
case COMM[I] of
'*', ' ','@','#','Q', 'T' : writeln (COMM[I], STNG[I]);
'N' : begin
write (COMM[I]);
for J := 1 to NPAR do write (PAR[I,J]:4);
J := PAR [I,3];
writeln (FORMAT[J,1]:4, FORMAT[J,2]:4,' ',
NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]);
end;
else begin
write (COMM[I]);
for J := 1 to NPAR do write (PAR[I,J]:4);
writeln (' ', STNG[i]); end;
end; { case }
end;
writeln; writeln; writeln;
end;
procedure EDIT_L;
begin
CLR_LINES(23,25);
gotoxy (1,23); write ('EDIT #',LE:4,' => ', COMM [LE]:1,' ');
for i := 1 to NPAR do write(PAR [LE,i]:6); I := 1;
repeat
PAR [LE,i] := trunc(INPUT_REAL(13+6*i,23,PAR[LE,i],0,640,4,0,CH));
i := CURSOR_MOVE (i, 1, NPAR, CH);
until ch in [^M, ^[, ^R,^C ];
end;
begin
ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas');
LE := 1; CH := ^E; LFR := 1; LTO := TOP;
if TOP > 0 then begin
repeat
if CH in [^A,^E,^R, ^Z,^X,^C] then LIST;
gotoxy (1,24); write ('<Esc> = exit. Enter line # to edit :');
LE := trunc(INPUT_REAL (38,24,LE, 1, TOP, 3, 0, CH));
if CH in [^M,^A,^E,^R, ^Z,^X,^C] then EDIT_L;
until CH = ^[;
end;
end;
function STAT(K : integer) : string80;
var
NUM : array [1..npar] of string10;
J : integer;
begin
if (0 < K) and (K <= TOP) then
if COMM [K] in ['A','B','C','D','W','N'] then begin
STR (PAR[K,1], NUM[1]);
for j := 2 to NPAR do begin
STR (PAR[K,J]:2, NUM[J]); NUM[J] := CONCAT (',',NUM[J]);
end;
CASE COMM[K] OF
'A':STAT:=CONCAT ('ARROW (',NUM[1],NUM[2],NUM[3],NUM[4],');');
'B':STAT:=CONCAT ('BOX (',NUM[1],NUM[2],NUM[3],NUM[4],');');
'C':STAT:=CONCAT ('CIRCLE(',NUM[1],NUM[2],NUM[3],');');
'D':STAT:=CONCAT ('DRAW (',NUM[1],NUM[2],NUM[3],NUM[4],');');
'W':STAT:=CONCAT ('WRS (',NUM[1],NUM[2],',''', STNG [K],''');');
end;
end;
end;
(*---- Make draws begin ----*)
procedure CURSOR (COLOR : integer);
begin
DRAW (X-5,Y-5, X+5, Y+5, COLOR); DRAW (X-5,Y+5, X+5,Y-5, COLOR);
(* DRAW (X-5, Y, X+5, Y, COLOR); DRAW (X, Y-5, X , Y+5, COLOR);*)
end;
procedure MOVE_CURSOR;
begin
repeat
CH_MOVE := GET_CHAR;
case CH_MOVE of
'X' : INCX := INCX + 1; 'x' : INCX := INCX - 1;
'Y' : INCY := INCY + 1; 'y' : INCY := INCY - 1;
end;
if Upcase (CH_MOVE) in ['X','Y'] then begin
gotoxy(16, YTEXT1); write(INCX:2); gotoxy(22,YTEXT1); write(INCY:2);
end;
until CH_MOVE IN [^A,^E,^R, ^S,^D, ^Z,^X,^C, ' '];
CURSOR (0);
CASE CH_MOVE OF
^A, ^E, ^R : Y := Y - INCY; {UP }
^Z, ^X, ^C : Y := Y + INCY; {DOWN }
^S : X := X - INCX; {LEFT }
^D : X := X + INCX; {RIGHT }
end;
CASE CH_MOVE OF
^A, ^Z : X := X - INCX; {LEFT }
^R, ^C : X := X + INCX; {RIGHT }
end;
IF X < 0 THEN X := 0; IF X > 639 THEN X := 639;
IF Y < 0 THEN Y := 0; IF Y > 199 THEN Y := 199;
IF CH_MOVE <> ' ' THEN CURSOR (1);
gotoxy (3,YTEXT1);write(X:3); gotoxy(9,YTEXT1); write(Y:3);
end;
procedure COLOR_BOXES;
begin
if not HIRES_MODE then begin
BOX (280, YTEXT2*8-8,288,YTEXT2*8-1, 1); fillShape (284, YTEXT2*8-4,0,1);
BOX (290, YTEXT2*8-8,298,YTEXT2*8-1, 1); fillShape (294, YTEXT2*8-4,1,1);
BOX (300, YTEXT2*8-8,308,YTEXT2*8-1, 1); fillShape (304, YTEXT2*8-4,2,1);
BOX (310, YTEXT2*8-8,318,YTEXT2*8-1, 1); fillShape (314, YTEXT2*8-4,3,1);
end;
end;
procedure ASK_POSITION;
var
CH3 : CHAR; ST : STRING80; TMP : REAL;
begin
repeat
if HIRES_MODE then
CH3:=SCRIO_CHAR(1,YTEXT1,'<RETURN>=add line, <R>=replace, <Esc>=cancel')
else
CH3:=SCRIO_CHAR(1,YTEXT1,'<RET>=add, <R>eplace, <Esc>=Exit');
until CH3 in ['R', 'I', ^M, ^[ ];
case CH3 of
'R' : begin
gotoxy(1,YTEXT1); write (' ':39);
TMP := SCRIO_REAL (1,YTEXT1,'Replace line #', 0, TOP, 3,0);
POSI := TRUNC(TMP);
if POSI > 0 then begin
ST := STAT (POSI); gotoxy (1,YTEXT1);
write ('Replacing..<RETURN>=con.,<Esc>=Cancel');
gotoxy (1,YTEXT3); write (ST);
CH3 := INPUT_CHAR;
if CH3 = ^M then begin
EXEC (POSI, false);
COMM[POSI] := COMM [TOPP1]; STNG [POSI] := STNG [TOPP1];
FOR I := 1 TO NPAR DO PAR[POSI,I] := PAR [TOPP1,I];
end;
gotoxy (1,YTEXT3); write (' ':50);
end;
end;
^M : begin
TOP := TOP + 1; { Return }
if COMM [TOP] = 'N' then TOP_NUMB := TOP_NUMB + 1;
end;
^[ : EXEC (TOPP1, false); { Esc }
end {case}
end;
procedure MAKE (CODE : char; ST_CODE : string10);
var
LEN1, CP, TAKEN, F1, F2, F3 : integer; EC : char;
procedure SECOND_POINT;
begin
repeat
MOVE_CURSOR;
EXEC (TOPP1, false);
case CODE of
'C', 'S' : PAR[TOPP1,3] :=
round( SQRT( SQR( PAR[TOPP1,1]-X ) + SQR( PAR[TOPP1,2]-Y ) ));
'A','B','D','G' : begin
PAR [TOPP1,3] := X; PAR [TOPP1,4] := Y; end;
'N' : begin
PAR [TOPP1,1] := (X div 8)+1; PAR [TOPP1,2] := (Y div 8)+1;
gotoxy (LEN1,YTEXT2);
write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end;
'W' : begin
PAR [TOPP1,1] := X; PAR [TOPP1,2] := Y;
gotoxy (LEN1,YTEXT2);
write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end;
end;
EXEC (TOPP1,true);
until CH_MOVE = ' ';
end;
begin
TOPP1 := TOP + 1;
for i := 1 to NPAR do PAR [TOPP1,I] := 0;
STNG [TOPP1] := '';
COMM [TOPP1] := CODE;
PAR [TOPP1,5] := ACTIVE_COLOR;
LEN1 := LENGTH (ST_CODE) + 1;
case CODE of
'W' : begin gotoxy (1,YTEXT2); write('String ? '); read (STNG [TOPP1]);
write(' Direction ?'); readln (PAR [TOPP1,3]);
INCX := 8; INCY := 8; end;
'G' : begin gotoxy (1,YTEXT2); write('Function # ? ');read (STNG [TOPP1]);
end;
'S' : begin { Circle Segment }
gotoxy (1,YTEXT2); write ('Ang Begin & End :');
readln (PAR [TOPP1,4],PAR [TOPP1,5]);
end;
'N' : begin
TNUMBP1 := TOP_NUMB + 1; gotoxy (1,YTEXT2); write (' ':40);
gotoxy (1,YTEXT3); write('# Pos = -- # Dec = --');
gotoxy (1,YTEXT2); write(' Indx = -- Value = ');
CP := 1; TAKEN := 0; F1 := 2; F2 := 0; F3 := 0; NUMB[TNUMBP1] := 0;
repeat
case CP of
1 : F1 := trunc(INPUT_REAL (8,YTEXT3,F1, 1,40, 3,0,EC));
2 : F2 := trunc(INPUT_REAL (22,YTEXT3,F2, 0, 9, 3,0,EC));
3 : F3 := trunc(INPUT_REAL (8,YTEXT2, F3,-99,99, 3,0,EC));
4 : numb [TNUMBP1] := INPUT_REAL (22,YTEXT2, NUMB[TNUMBP1],
-9.9E9, 9.9E9,F1, F2, EC);
end;
TAKEN := TAKEN or (1 shl (CP-1));
CP := CURSOR_MOVE (CP, 1, 4, EC);
until (EC = ^M) and (TAKEN = $0F);
CLR_LINES (YTEXT2,YTEXT3); FORMAT [TNUMBP1,1]:=F1;
FORMAT [TNUMBP1,2]:=F2; PAR [TOPP1,4] := F3;
PAR [TOPP1,3] := TNUMBP1; NUM_IDX [TNUMBP1] := TOPP1;
X := (X div 8) * 8; Y := (Y div 8) * 8;
INCX := 8; INCY := 8; end;
'F' : begin
COLOR_BOXES;
gotoxy (1,YTEXT2); write ('FillColor :','Border :':12);
PAR [TOPP1,5]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
PAR [TOPP1,4] := trunc (INPUT_REAL (25,YTEXT2,0,0,3,2,0,ec));
end;
end;
CLR_LINES(YTEXT2,YTEXT2); gotoxy (1,YTEXT2); write(ST_CODE);
CURSOR (1);
repeat
MOVE_CURSOR;
until CH_MOVE = ' ';
PAR [TOPP1,1] := X; PAR [TOPP1,2] := Y;
case CODE of
'N' : begin { from HIRES to TEXTMODE }
PAR [TOPP1,1] := (X div 8)+1; PAR [TOPP1,2] := (Y div 8)+1; end;
'A','B','D','G' : begin
PAR [TOPP1,3] := X; PAR [TOPP1,4] := Y; end;
end;
gotoxy (LEN1,YTEXT2); write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ',');
CURSOR (1);
if CODE in ['W','N'] then EXEC (TOPP1, true);
if CODE = 'F' then begin
CURSOR (0); exec_all (false);
EXEC (TOPP1, true) ; end
else
SECOND_POINT;
gotoxy (LEN1 + 8,YTEXT2); write (PAR[TOPP1,3]:3, ',',PAR[TOPP1,4]:3, ')');
ASK_POSITION;
end;
procedure CHNG_INPUT_AREA;
begin
if YTEXT1 = 1 then begin CLR_AREA (1,1, 80,3, $0, 2,0);
YTEXT1 := 25; YTEXT2 := 24; YTEXT3 := 23; YGRAPH := 180; end
else begin CLR_AREA (1,23, 80,25, $0, 2,0);
YTEXT1 := 1; YTEXT2 := 2; YTEXT3 := 3; YGRAPH := 20; end;
EXEC_ALL (false);
end;
procedure PROMPED (S : STRING15);
begin
CLR_LINES (YTEXT1, YTEXT2);
draw (0,YGRAPH, 639,YGRAPH,1); gotoxy (1,YTEXT1);
write ('X=',X:3,' Y=',Y:3,' Ix=',INCX:2,' IY=',INCY:2,' # S=',TOP:3);
gotoxy (1,YTEXT2); write ( S );
end;
procedure HELP;
var BUFFER : array [1..16287] of byte;
procedure HELP_CTRL (PAGE : integer);
var CH : char; code : integer;
begin
repeat
clrscr; gotoxy (1,1); write ('Page:', (PAGE-1):3);
display_page (PAGE,0,0);
gotoxy (1,24); write ('<Esc> = Exit, (1-5) = Help page #');
CH := GET_CHAR;
if CH in ['1'..'5'] then
begin Val (CH,page,code); page := page + 1; end;
until CH in [^[, ^M];
end;
begin
if SCR_MODE < 4 then
HELP_CTRL (2)
else begin
if HIRES_MODE then
GetPic (BUFFER, 0,0,639, 199) else GetPic (BUFFER, 0,0,319, 199);
TextMode; HELP_CTRL (2);
if HIRES_MODE then HiRes else GraphColorMode;
PutPic (BUFFER, 0,199);
end;
end;
{ ========================== }
procedure SETP (CODE : char; ST_CODE : string10);
var EC : char;
begin
gotoxy (1,YTEXT2); write (ST_CODE);
case CODE of
'C' : begin
COLOR_BOXES;
ACTIVE_COLOR:=trunc(INPUT_REAL(16,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
end;
'P' : begin
TOPP1 := TOP + 1;
for i := 1 to NPAR do PAR [TOPP1,i] := 0; STNG [TOPP1] := '';
COMM [TOPP1] := 'P';
PAR [TOPP1,1]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
exec (TOPP1, true);
ASK_POSITION;
end;
'@','#','T' : begin
TOP := TOP + 1;
for i := 1 to NPAR do PAR [TOP,i] := 0; COMM [TOP] := CODE;
read (STNG [TOP] );
end;
end;
end;
procedure EDIT;
var SW_EXIT, SW_MODE, SW_CARD : boolean; PROM_STR : STRING15;
begin
clrscr;
if SCRIO_CHAR (30, 12, 'Hires or Graphics mode ? (H/G)') = 'H' then begin
HIRES_MODE := true; hires; hirescolor (1); X := 320; end
else begin
HIRES_MODE := false; graphColorMode; X := 160;
end;
SW_MODE := false; PROM_STR := 'COMMAND ?';
if SW_CARD then begin
fillchar ( mem[$BC00:0], 16384, 0 ); { see NOTE 1 }
port [$3D9] := 32; PORT [$3DD] := 32;
end;
Y := 100; INCX := 8; INCY := 5; SW_EXIT := false;
YTEXT1 := 25; YTEXT2 := 24; YTEXT3 := 23; YGRAPH := 180;
ACTIVE_COLOR := 1;
EXEC_ALL (FALSE);
repeat
PROMPED ( PROM_STR );
RESP := Upcase (INPUT_CHAR);
if SW_MODE and (RESP in ['A'..'Z']) then SAVE_FILE := true;
if SW_MODE then
CASE RESP OF
'A' : MAKE ('A', 'ARROW (');
'B' : MAKE ('B', 'BOX (');
'C' : MAKE ('C', 'CIRCLE (');
'S' : MAKE ('S', 'CircSeg (');
'D' : MAKE ('D', 'DRAW (');
'G' : MAKE ('G', 'GRAPH (');
'N' : MAKE ('N', 'NUMBER (');
'W' : MAKE ('W', 'write (');
'F' : MAKE ('F', 'Fill (');
{????} 'E' : SETP ('C', 'Active-color :');
'P' : SETP ('P', 'Pallete :');
'@' : SETP ('@', '@ Segment Comment :');
'#' : SETP ('#', '# End Seg.Comment :');
'T' : SETP ('T', 'T title Comment :');
'?' : HELP;
^[ : begin PROM_STR := 'COMMAND ?'; SW_MODE := false; end;
else write (^G);
end
else
CASE UPCASE(RESP) OF
'P' : begin CLR_AREA (0,0, 639,199,$0,1,0); EXEC_ALL (TRUE);
readln(KBD); end;
'R' : EXEC_ALL (FALSE);
'S' : begin CODE_WRITE; SAVE_FILE := false; end;
'I' : CHNG_INPUT_AREA;
'?' : HELP;
'K' : begin graphWindow (20,20,50,50);
READLN (I); HIRESCOLOR (I); end;
'D' : begin PROM_STR := 'DRAWING ?'; SW_MODE := true; end;
^[ : SW_EXIT := true;
else write (^G);
end;
until SW_EXIT;
textmode;
end;
function CHECK_SAVE : boolean;
begin
gotoxy (5,25); write (^g, ^g, 'The file in memory :',CODE_in_MEM,
'has not been saved, SAVE IT ? (Y/N)');
repeat
RESP := Upcase (INPUT_CHAR);
until RESP in ['Y','N'];
CHECK_SAVE := (RESP = 'Y');
end;
procedure NO_DEF;
begin
gotoxy (10,22); writeln ('There in NO file name defined', ^G, ^G);
writeln ('Use the CREATE, LOAD or RENAME options to define a name');
readln;
end;
procedure GET_FN;
begin
write ('The existing file names are:':53);
LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP);
gotoxy (20,21); write ('Give NEW File Name (w/o ext.) ?:');
read (FNAME);
if FNAME <> '' then begin
CFNAME := FNAME + '.cod';
CODE_in_MEM := CFNAME;
assign (CODEFILE, CFNAME);
end;
end;
begin { MAIN }
{ for i := 1 to NLIM do STNG [i] := ''; }
TOP := 0; SW_CARD := True; SAVE_FILE := false;
CODE_in_MEM := '-none-';
READ_SCREENS ('EDGRA.men'); ITM := 1;
repeat
DISPLAY_PAGE (1, 0, 1);
gotoxy (28,3); write (DefaultDrive);
gotoxy (28,4); write (CODE_in_MEM);
ITM := CHOOSE_LINES (1, ITM, 10, 0);
case ITM of
1 : HELP;
{ed} 2 : if CODE_in_MEM = '-none-' then NO_DEF else EDIT;
{Run} 3 : if CODE_in_MEM = '-none-' then NO_DEF else begin
SW_COLOR := true; SW_CARD := true;
HIRES_MODE := true; INCX := 2;
RUN_GRAFI (CFNAME, INCX, resp, 0, 0);
end;
{List} 4 : if CODE_in_MEM = '-none-' then NO_DEF else CODE_LIST;
{Crea} 5 : begin
if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;
ClrScr; writeln ('C R E A T E':45);
GET_FN;
if FNAME <> '' then begin
TOP := 0; TOP_SEGMENT := 0; TOP_NUMB := 0; end
end;
{Load} 6 : begin
if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;
ClrScr;
LIST_GET_FILEN ('G', '????????.cod-', FNAME, RESP);
if RESP <> ^[ then begin
CFNAME := FNAME + '.cod';
CODE_in_MEM := CFNAME;
assign (CODEFILE, CFNAME);
CODE_READ;
end;
end;
{Save} 7 : if CODE_in_MEM = '-none-' then NO_DEF else begin
CODE_WRITE;
SAVE_FILE := false;
end;
8 : begin ClrScr; writeln ('R E N A M E':45);
GET_FN;
end;
9 : SET_DRIVE ( SCRIO_CHAR (10, 21,'Enter new drive') );
10 : begin ClrScr; LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP);
end;
end;
until ITM = 0;
if SAVE_FILE then if CHECK_SAVE then CODE_WRITE; CLRSCR;
end.
'@' : begin { Define Segment }
if TOP_SEGMENT >= TOPSEG_LIM then ERROR (3)
else begin
TOP_SEGMENT := TOP_SEGMENT + 1;
COLOR_SEG [TOP_SEGMENT,1] := TOP + 1; { begin_line }
COLOR_SEG [TOP_SEGMENT,2] := 0; { end_line }
if TOP_SEGMENT > 1 then
COLOR_SEG [TOP_SEGMENT-1,2] := TOP - 1; { end_line }
read (CODEFILE, STNG[TOP]);
end;
end;
'#' : if TOP_SEGMENT > 0 then
COLOR_SEG [TOP_SEGMENT,2] := TOP - 1; { end_line }
'T' : begin TITLE_SEG [1] := TOP + 1; { Tiles !! }
read (CODEFILE, STNG[TOP]); end;
'Q' : begin { End Ploting }
TOP := TOP - 1; { Do NOT keep Q }
if (TOP_SEGMENT > 0) and (COLOR_SEG [TOP_SEGMENT,2] = 0) then
COLOR_SEG [TOP_SEGMENT,2] := TOP; { end_line }
TITLE_SEG [2] := TOP;
end;